home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 011 / flips12.arc / FLIPSDOR.BAS < prev    next >
Encoding:
BASIC Source File  |  1986-04-17  |  23.6 KB  |  594 lines
  1. 1000 '
  2. 1010 ' COMPILER COMMANDS:
  3. 1020 '                   $TITLE:    '> FLIPS <  John Intorcio'
  4. 1030 '                   $SUBTITLE: 'VER 1.2  April 17, 1986'
  5. 1040 CLS
  6. 1050 PRINT "      ╔═══════════════════════════════════════════════════╗"
  7. 1060 PRINT "      ║             > F L I P S <   Ver. 1.2              ║"
  8. 1070 PRINT "      ║                                                   ║"
  9. 1080 PRINT "      ║  This program is distributed as user supported    ║"
  10. 1090 PRINT "      ║  software.  You are free to copy and distribute   ║"
  11. 1100 PRINT "      ║  this program provided:                           ║"
  12. 1110 PRINT "      ║                                                   ║"
  13. 1120 PRINT "      ║      1. It is not distributed in modified form.   ║"
  14. 1130 PRINT "      ║      2. No fee or consideration is charged.       ║"
  15. 1140 PRINT "      ║      3. This message is not bypassed or removed.  ║"
  16. 1150 PRINT "      ║                                                   ║"
  17. 1160 PRINT "      ║   If you run this program and find it usefull     ║"
  18. 1170 PRINT "      ║   and if you would like to make a contribution    ║"
  19. 1180 PRINT "      ║   toward the development of future versions or    ║"
  20. 1190 PRINT "      ║   if you discover problems or fixes write to:     ║"
  21. 1200 PRINT "      ║                                                   ║"
  22. 1210 PRINT "      ║            John Intorcio                          ║"
  23. 1220 PRINT "      ║            247 State Street                       ║"
  24. 1230 PRINT "      ║            Northampton, MA 01060                  ║"
  25. 1240 PRINT "      ║                                                   ║"
  26. 1250 PRINT "      ║    Or contact <The ToolBox> at (617) 364-2474     ║"
  27. 1260 PRINT "      ╚═══════════════════════════════════════════════════╝"
  28. 1270 PAUSE.TIME = 4:GOSUB 4920
  29. 1280 '
  30. 1290 '  --------- GET NODE RECORD FROM COMMAND LINE ---------
  31. 1300 '  --------- TO ALLOW ASSIGNMENT TO PROPER PORT --------
  32. 1310 '  --- NOTE: THIS COMMAND WILL NOT WORK PROPERLY UNDER INTERPRETER --
  33. 1320 '
  34. 1330 NODE.NUMBER = VAL(COMMAND$):IF NODE.NUMBER = 0 THEN NODE.NUMBER = 1
  35. 1340 '
  36. 1350 '  --------- SET UP ---------
  37. 1360 '
  38. 1370 ON ERROR GOTO 6300
  39. 1380 DIM COMM.PORTS$(5),FACE$(2),SC(3),A(9,9),I4(7),J4(7),P$(2):Z0 = 0
  40. 1390 GOSUB 5810 'READ CONFIG FILE
  41. 1400 '
  42. 1410 '  --------- CHECK FOR NODE CONFIGURATION --------
  43. 1420 '
  44. 1430 IF COMM.PORTS$(NODE.NUMBER) = "NONE" THEN ERROR 200
  45. 1440 GOSUB 5060 'GET USER PARAMETERS AND INITIALIZE COMM PORT
  46. 1450 '
  47. 1460 ' --------- SET EXIT TRAPS ---------
  48. 1470 '
  49. 1480 ON TIMER(MAX.TIME*60) GOSUB 2060
  50. 1490 TIMER ON
  51. 1500 START.TIME$ = TIME$:START.SECONDS = VAL(MID$(START.TIME$,1,2))*3600+VAL(MID$(START.TIME$,4,2))*60+VAL(MID$(START.TIME$,7,2))
  52. 1510 KEY OFF:LOCATE 25,1
  53. 1520 PRINT "FLIPS From John Intorcio        "+USER.NAME$;TAB(60);"Time in: "+TIME$
  54. 1530 LOCATE 24,1
  55. 1540 IF GRAPHICS.FLAG = 1 THEN GRAPHICS.FLAG = 0 ELSE GRAPHICS.FLAG = 1
  56. 1550 START.FLAG = 1:GOTO 4500 'INITIALIZE GRAPHICS
  57. 1560 '
  58. 1570 ' ---------  GET SCORE --------
  59. 1580 '
  60. 1590 OPEN "FLIPS.PTS" FOR INPUT AS #4
  61. 1600 INPUT #4,GAMES.PLAYED,COMP.WINS,HUMAN.WINS,LAST.USER$
  62. 1610 CLOSE #4
  63. 1620 START.FLAG = 0
  64. 1630 '
  65. 1640 ' --------- CHECK FOR REPEAT USER ---------
  66. 1650 '
  67. 1660 IF LAST.USER$ <> USER.NAME$ OR ALLOW.REPEAT.USER$ = "YES" THEN 1730
  68. 1670 '
  69. 1680 ' --------- THIS IS REPEAT USER! GIVE A LITTLE NOTE AND RETURN ----
  70. 1690 '
  71. 1700 MSG$=CLEAR.SCR$+"SORRY, YOU'VE ALLREADY PLAYED FLIPS!!!!!":GOSUB 5270
  72. 1710 MSG$="LET'S GIVE SOMEONE ELSE A CHANCE!"+LINE.FEED$+LINE.FEED$:GOSUB 5270
  73. 1720 GOTO 5710
  74. 1730 '
  75. 1740 ' -------- DISPLAY WELCOME SCREEN --------
  76. 1750 '
  77. 1760 TEXT.FILE$ = WEL.PATH$ + WELCOME.SCR$:GOSUB 4720
  78. 1770 '
  79. 1780 ' --------- EXECUTE MAIN MENU ----------------
  80. 1790 '
  81. 1800 WHILE GAMES < MAX.GAMES
  82. 1810 MSG$ = CLEAR.SCR$:GOSUB 5270
  83. 1820 MSG$ = "GAMES PLAYED: "+STR$(GAMES.PLAYED)+"  COMPUTER: "+STR$(COMP.WINS)+"  HUMANS: "+STR$(HUMAN.WINS)
  84. 1830 MSG$ = MSG$+LINE.FEED$+LINE.FEED$:GOSUB 5270
  85. 1840 MSG$ = "     *****  FLIP VER. 1.2 MAIN MENU ******    FLIPS NODE: "+STR$(NODE.NUMBER):GOSUB 5270
  86. 1850 MSG$ = LINE.FEED$ + LINE.FEED$:GOSUB 5270
  87. 1860 MSG$ = "  REMEMBER:  WHILE PLAYING THE GAME YOU MAY ENTER Q AT ANY TIME TO":GOSUB 5270
  88. 1870 MSG$ = "             QUIT.  ALSO, ENTER YOUR MOVE AS A0 IF YOU MUST FORFEIT!":GOSUB 5270
  89. 1880 MSG$ = LINE.FEED$ + LINE.FEED$:GOSUB 5270
  90. 1890 MSG$ = "  1. PLAY GAME":GOSUB 5270
  91. 1900 MSG$ = "  2. DISPLAY INSTRUCTIONS":GOSUB 5270
  92. 1910 MSG$ = "  3. TOGGLE GRAPHICS.  NOW: "
  93. 1920 IF GRAPHICS.FLAG = 1 THEN MSG$ = MSG$ + "ASCII" ELSE MSG$ = MSG$ + "NONE"
  94. 1930 GOSUB 5270
  95. 1940 MSG$ = "  4. TOGGLE LINE FEEDS.  NOW: "
  96. 1950 IF LF.FLAG = 1 THEN MSG$ = MSG$ + "ON" ELSE MSG$ = MSG$ + "OFF"
  97. 1960 GOSUB 5270
  98. 1970 MSG$ = "  5. RETURN TO " + BOARD.NAME$:GOSUB 5270
  99. 1980 MSG$ = LINE.FEED$ + LINE.FEED$:GOSUB 5270
  100. 1990 MSG$ = "YOUR SELECTION ?":GOSUB 5410
  101. 2000 OPT = INT(VAL(RSP$)):IF OPT < 1 OR OPT > 5 THEN 1770
  102. 2010 ON OPT GOTO 4330,4450,4500,4670,5720
  103. 2020 GOTO 1770
  104. 2030 WEND
  105. 2040 MSG$ = CLEAR.SCR$ + "MAXIMUM GAMES REACHED.":GOSUB 5270
  106. 2050 GOTO 5720
  107. 2060 MSG$ = CLEAR.SCR$ + "MAXIMUM TIME REACHED.":GOSUB 5270
  108. 2070 GOTO 5720
  109. 2080 '
  110. 2090 ' --------- SUBROUTINE TO INITIALIZE GAME BOARD AND VARIABLES ---------
  111. 2100 '
  112. 2110 XL = 3:XH = 6:YL = 3:YH = 6
  113. 2120 NP = 1:S2 = 2:S4 = 1:S5 = - 2
  114. 2130 B = -1:W = 1:PT = 0
  115. 2140 FOR K = 0 TO 7
  116. 2150 IF GAMES < 1 THEN READ I4(K),J4(K)
  117. 2160 NEXT 
  118. 2170 FOR I = 0 TO 9:FOR J = 0 TO 9
  119. 2180 A(I,J) = 0
  120. 2190 NEXT J,I
  121. 2200 A(4,4)= W:A(5,5)= W
  122. 2210 A(4,5)= B:A(5,4)= B
  123. 2220 SC(1)= 2:SC(2)= 2:N1= 4:Z= 0
  124. 2230 C= B:H= W
  125. 2240 MSG$=CLEAR.SCR$+"DO YOU WANT TO GO FIRST (Y OR N) ? ":GOSUB 5410
  126. 2250 TEMP$=RSP$:GOSUB 4240:RSP$=TEMP$
  127. 2260 PT= 1:IF RSP$= "Y" THEN PT= 0
  128. 2270 RETURN
  129. 2280 '
  130. 2290 ' --------- SUBROUTINE TO GET COMPUTERS MOVE ---------
  131. 2300 '
  132. 2310 GOTO 2350
  133. 2320 IF PT= 2 THEN B1= - 1:I3= 0:J3= 0:T1= C:T2= H
  134. 2330 IF PT= 1 THEN B1= - 1:I3= 0:J3= 0:T1= H:T2= C
  135. 2340 GOTO 2790
  136. 2350 PT= PT+ 1:IF PT> 2 THEN PT= 1
  137. 2360 B1= - 1:I3= 0:J3= 0:T1= C:T2= H
  138. 2370 FOR I= YL TO YH:FOR J= XL TO XH
  139. 2380 IF A(I,J)< > 0 THEN 2540
  140. 2390 GOSUB 3460
  141. 2400 IF F1 = Z0 THEN 2540
  142. 2410 U = - 1
  143. 2420 GOSUB 3520
  144. 2430 IF S1 = Z0 THEN 2540
  145. 2440 IF (I = 1)OR (I = 8)THEN S1 = S1+ S2
  146. 2450 IF (J = 1)OR (J = 8)THEN S1 = S1+ S2
  147. 2460 IF (I = 2)OR (I = 7)THEN S1 = S1+ S5
  148. 2470 IF (J = 2)OR (J = 7)THEN S1 = S1+ S5
  149. 2480 IF (I = 3)OR (I = 6)THEN S1 = S1+ S4
  150. 2490 IF (J = 3)OR (J = 6)THEN S1 = S1+ S4
  151. 2500 IF S1< B1 THEN 2540
  152. 2510 IF S1> B1 THEN 2530
  153. 2520 IF RND (1)> .5 THEN 2540
  154. 2530 B1 = S1:I3 = I:J3 = J
  155. 2540 NEXT J,I
  156. 2550 IF B1 > 0 THEN 2630
  157. 2560 IF S5 = 0 THEN 2590
  158. 2570 IF NP = 1 THEN S5 = 0:GOTO 2360
  159. 2580 S5 = 0:GOTO 2290
  160. 2590 S5 = 0:MSG$ = "I HAVE TO FORFEIT MY MOVE.":GOSUB 5270
  161. 2600 IF Z = 1 THEN 3160
  162. 2610 Z = 1
  163. 2620 GOTO 2740
  164. 2630 Z = 0
  165. 2640 MSG$ = "I WILL MOVE TO "+RIGHT$ (STR$ (I3),1)+" "+CHR$(J3+ 64):GOSUB 5270
  166. 2650 I = I3:J = J3:U = 1
  167. 2660 GOSUB 3700
  168. 2670 GOSUB 3520
  169. 2680 SC(PT) = SC(PT) + S1 + 1
  170. 2690 OP = PT + 1:IF OP = 3 THEN OP = 1
  171. 2700 SC(OP) = SC(OP) - S1
  172. 2710 N1 = N1 + 1
  173. 2720 MSG$ = "THAT GIVES ME " + STR$(S1) + " OF YOUR PIECES.":GOSUB 5270
  174. 2730 IF (SC(OP) = 0) OR (N1 = 64) THEN 3160
  175. 2740 T1 = H:T2 = C
  176. 2750 RETURN
  177. 2760 '
  178. 2770 ' --------- SUBROUTINE FOR PLAYER'S MOVE ---------
  179. 2780 '
  180. 2790 PT = PT + 1:IF PT > 2 THEN PT = 1
  181. 2800 IF PT = 2 THEN B1 = - 1:I3 = 0:J3 = 0:T1 = C:T2 = H
  182. 2810 IF PT = 1 THEN B1 = - 1:I3 = 0:J3 = 0:T1 = H:T2 = C
  183. 2820 MSG$=FACE$(2) +", YOUR MOVE ? ":GOSUB 5350:GOSUB 3780
  184. 2830 IF (I < 0) OR (J < 0) OR (J > 8) OR (I > 8) THEN 2800
  185. 2840 IF I <> 0 THEN 2910
  186. 2850 MSG$ = "ARE YOU FORFEITING YOUR TURN (Y OR N) ? ":GOSUB 5410
  187. 2860 TEMP$ = RSP$:GOSUB 4240:RSP$ = TEMP$
  188. 2870 IF RSP$ <> "Y" THEN GOTO 2800
  189. 2880 IF Z = 1 THEN 3160
  190. 2890 Z1 = 1
  191. 2900 GOTO 3140
  192. 2910 IF A(I,J) = 0 THEN 2940
  193. 2920 MSG$ = "SORRY,SQUARE OCCUPIED; TRY AGAIN":GOSUB 5270
  194. 2930 GOTO 2800
  195. 2940 GOSUB 3460
  196. 2950 IF F1 = 1 THEN 2980
  197. 2960 MSG$ = "SORRY,NOT NEXT TO MY PIECES; TRY AGAIN":GOSUB 5270
  198. 2970 GOTO 2800
  199. 2980 U = -1
  200. 2990 GOSUB 3520
  201. 3000 IF S1 > 0 THEN 3030
  202. 3010 MSG$ = "SORRY,DOESN'T FLANK A ROW; TRY AGAIN":GOSUB 5270
  203. 3020 GOTO 2800
  204. 3030 Z = 0
  205. 3040 MSG$ = " THAT GIVES YOU "+STR$(S1)+" PIECE":
  206. 3050 GOSUB 3700
  207. 3060 IF S1 > 1 THEN MSG$ = MSG$ + "S"
  208. 3070 GOSUB 5270:U = 1
  209. 3080 GOSUB 3540
  210. 3090 SC(PT) = SC(PT) + S1 + 1
  211. 3100 OP = PT + 1:IF OP = 3 THEN OP = 1
  212. 3110 SC(OP) = SC(OP) - S1
  213. 3120 N1 = N1 + 1
  214. 3130 IF SC(OP) = 0 OR N1 = 64 THEN 3160
  215. 3140 RETURN
  216. 3150 '
  217. 3160 ' --------- SUBROUTINE FOR CLOSE OF GAME  ---------
  218. 3170 '
  219. 3180 MSG$ = "YOU HAVE "+STR$(SC(1))+" PIECES   ":GOSUB 5270
  220. 3190 MSG$ = "I HAVE "+STR$(SC(2))+" PIECES": GOSUB 5270
  221. 3200 IF SC(1) = SC(2) THEN 3240
  222. 3210 IF SC(1) > SC(2) THEN 3260
  223. 3220 MSG$="SORRY, I WON THAT ONE.  ":GOSUB 5350
  224. 3230 GAMES.PLAYED = GAMES.PLAYED + 1:COMP.WINS = COMP.WINS + 1:GOTO 3280
  225. 3240 MSG$="ITS A TIE !!":GOSUB 5350
  226. 3250 GAMES.PLAYED = GAMES.PLAYED + 1:GOTO 3430
  227. 3260 MSG$ = "YOU WON!!!!!!  ":GOSUB 5350
  228. 3270 GAMES.PLAYED = GAMES.PLAYED + 1:HUMAN.WINS = HUMAN.WINS + 1
  229. 3280 C1 = SC(1) - SC(2)
  230. 3290 IF C1 > 0 THEN 3310
  231. 3300 C1 = -C1
  232. 3310 C1 = (64 * C1) /  N1
  233. 3320 MSG$ = "THAT WAS A ":GOSUB 5350
  234. 3330 IF C1 < 11 THEN 3410
  235. 3340 IF C1 < 25 THEN 3400
  236. 3350 IF C1 < 39 THEN 3390
  237. 3360 IF C1 < 53 THEN 3380
  238. 3370 MSG$ = "PERFECT GAME!":GOTO 3420
  239. 3380 MSG$ = "WALKAWAY!":GOTO 3420
  240. 3390 MSG$ = "FIGHT!":GOTO 3420
  241. 3400 MSG$ = "HOT GAME!":GOTO 3420
  242. 3410 MSG$ = "SQUEAKER!"
  243. 3420 GOSUB 5270 
  244. 3430 PAUSE.TIME = 3:GOSUB 4920
  245. 3440 GAMES = GAMES + 1:GOTO 1770
  246. 3450 '
  247. 3460 ' --------- CHECK FOR FLANK ---------
  248. 3470 '
  249. 3480 F1 = Z0:FOR I1 = -1 TO 1:FOR J1 = -1 TO 1:IF A(I + I1,J1 + J) = T2 THEN 3500
  250. 3490 NEXT J1,I1:RETURN 
  251. 3500 F1 = 1:RETURN
  252. 3510 '
  253. 3520 ' --------- SUBROUTINE TO CHECK FOR COUNT AND TO FLIP ---------
  254. 3530 '
  255. 3540 S1 = Z0:FOR K = 0 TO 7
  256. 3550 S3 = Z0:I5 = I4(K):J5 = J4(K):I6 = I + I5:J6 = J + J5
  257. 3560 IF A(I6,J6) <> T2 THEN 3670
  258. 3570 S3 = S3 + 1:I6 = I6 + I5:J6 = J6 + J5
  259. 3580 IF A(I6,J6) = T1 THEN 3610
  260. 3590 IF A(I6,J6) = Z0 THEN 3670
  261. 3600 GOTO 3570
  262. 3610 S1 = S1 + S3
  263. 3620 IF U <> 1 THEN 3670
  264. 3630 I6 = I:J6 = J
  265. 3640 FOR K1 = 0 TO S3
  266. 3650 A(I6,J6) = T1:I6 = I6 + I5:J6 = J6 + J5
  267. 3660 NEXT K1
  268. 3670 NEXT K
  269. 3680 RETURN 
  270. 3690 '
  271. 3700 '  --------- SET SEARCH LIMITS FOR COMPUTER MOVE ---------
  272. 3710 '
  273. 3720 IF I = YL THEN YL = YL - 1:IF YL < 1 THEN YL = 1
  274. 3730 IF I = YH THEN YH = YH + 1:IF YH > 8 THEN YH = 8
  275. 3740 IF J = XL THEN XL = XL - 1:IF XL < 1 THEN XL = 1
  276. 3750 IF J = XH THEN XH = XH + 1:IF XH > 8 THEN XH = 8
  277. 3760 RETURN 
  278. 3770 '
  279. 3780 ' -------- INPUT SUBROUTINE --------
  280. 3790 '
  281. 3800 I = -1:J = - 1
  282. 3810 CR.SUPPRESS = 1
  283. 3820 MSG$ = "":GOSUB 5410:TEMP$ = "":IF LEN(RSP$) = 0 THEN 3820
  284. 3830 IF LEN(RSP$) < 2 AND NOT (ASC(RSP$) = 81 OR ASC(RSP$) = 113) THEN MSG$ = ", ":TEMP$ = RSP$:GOSUB 5410
  285. 3840 TEMP$ = TEMP$ + RSP$:GOSUB 4240:RSP$ = TEMP$
  286. 3850 FOR K = 1 TO 2
  287. 3860 G = ASC(MID$(RSP$,K,1))
  288. 3870 IF G = 81 THEN 3220 'QUIT
  289. 3880 IF 47 < G AND G < 58 THEN I = G - 48
  290. 3890 IF 64 < G AND G < 74 THEN J = G - 64
  291. 3900 NEXT
  292. 3910 ECHO.OFF = 0:CR.SUPPRESS = 0
  293. 3920 MSG$ = "":GOSUB 5270:RETURN 
  294. 3930 '
  295. 3940 ' --------- BOARD DATA ---------
  296. 3950 '
  297. 3960 DATA 0,1,-1,1,-1,0,-1,-1,0,-1,1,-1,1,0,1,1
  298. 3970 '
  299. 3980 ' ----------- DRAW GAME BOARD ------------
  300. 3990 '
  301. 4000 MSG$ = CLEAR.SCR$+"         ***   F L I P S   ***":GOSUB 5270
  302. 4010 MSG$ = "":GOSUB 5270
  303. 4020 MSG$ = "     1   2   3   4   5   6   7   8":GOSUB 5270
  304. 4030 MSG$ = "   " + GRAPH1$:GOSUB 5270
  305. 4040 FOR I = 1 TO 8
  306. 4050 MSG$ = CHR$(I + 64) + " "
  307. 4060 FOR J = 1 TO 8
  308. 4070 MSG$ = MSG$ + " " + GRAPH4$
  309. 4080 FACE=(A(J,I)+3)/2:IF FACE=1.5 THEN MSG$=MSG$+"  " ELSE MSG$=MSG$+" "+FACE$(FACE)
  310. 4090 NEXT J
  311. 4100 MSG$=MSG$+" "+GRAPH4$
  312. 4110 IF I=3 THEN MSG$=MSG$+"   "+FACE$(2)+"  "+STR$(SC(1))
  313. 4120 IF I=5 THEN MSG$=MSG$+"   "+FACE$(1)+"  "+STR$(SC(2))
  314. 4130 IF I<>7 THEN 4170
  315. 4140 XTIME$=TIME$:SECONDS=VAL(MID$(XTIME$,1,2))*3600+VAL(MID$(XTIME$,4,2))*60+VAL(MID$(XTIME$,7,2))
  316. 4150 TIME.REM%=INT(MAX.TIME-(SECONDS-START.SECONDS)/60)
  317. 4160 MSG$=MSG$+STR$(TIME.REM%)+" MIN. REMAIN"
  318. 4170 GOSUB 5270
  319. 4180 IF I=8 THEN 4200
  320. 4190 MSG$="   "+GRAPH2$:GOSUB 5270
  321. 4200 NEXT I
  322. 4210 MSG$="   "+GRAPH3$:GOSUB 5270
  323. 4220 RETURN
  324. 4230 '
  325. 4240 ' --------- SUBROUTINE TO CONVERT TO UPPER CASE
  326. 4250 ' --------- ENTRY IS PASSED AS TEMP$
  327. 4260 '
  328. 4270 NCHR=LEN(TEMP$)
  329. 4280 FOR TEMP=1 TO NCHR
  330. 4290 TEST=ASC(MID$(TEMP$,TEMP,1)):IF TEST>93 THEN TEST=TEST-32
  331. 4300 MID$(TEMP$,TEMP,1)=CHR$(TEST):NEXT TEMP
  332. 4310 RETURN
  333. 4320 '
  334. 4330 ' --------- SUBROUTINE TO START ---------
  335. 4340 '
  336. 4350 MSG$=CLEAR.SCR$:GOSUB 5270
  337. 4360 GOSUB 2090                              'INITIALIZE BOARD
  338. 4370 GOSUB 3980                              'DISPLAY BOARD
  339. 4380 IF PT=0 THEN 4420                       'PLAYER GOES FIRST
  340. 4390 GOSUB 2290                              'COMPUTER'S MOVE
  341. 4400 PAUSE.TIME=COMP.MOVE.PAUSE:GOSUB 4920  'LET PLAYER SEE MOVE
  342. 4410 GOSUB 3980                              'DISPLAY UPDATED BOARD
  343. 4420 GOSUB 2770                              'PLAYER'S MOVE
  344. 4430 GOTO 4390                               'NEXT MOVE
  345. 4440 '
  346. 4450 ' --------- SUBROUTINE FOR INSTRUCTIONS ----------------
  347. 4460 '
  348. 4470 TEXT.FILE$=HLP.PATH$+HELP.FILE$:GOSUB 4720
  349. 4480 GOTO 1770
  350. 4490 '
  351. 4500 ' --------- TOGGLE GRAPHICS ---------
  352. 4510 '
  353. 4520 IF GRAPHICS.FLAG=1 THEN GRAPHICS.FLAG=0 ELSE GRAPHICS.FLAG=1
  354. 4530 IF GRAPHICS.FLAG=1 THEN 4600
  355. 4540 GRAPH1$="I---I---I---I---I---I---I---I---I"
  356. 4550 GRAPH2$="I---I---I---I---I---I---I---I---I"
  357. 4560 GRAPH3$="I---I---I---I---I---I---I---I---I"
  358. 4570 GRAPH4$="I"
  359. 4580 FACE$(1)="X":FACE$(2)="0"
  360. 4590 GOTO 4650
  361. 4600 GRAPH1$="╔═══╦═══╦═══╦═══╦═══╦═══╦═══╦═══╗"
  362. 4610 GRAPH2$="╠═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╣"
  363. 4620 GRAPH3$="╚═══╩═══╩═══╩═══╩═══╩═══╩═══╩═══╝"
  364. 4630 GRAPH4$="║"
  365. 4640 FACE$(1)=CHR$(1):FACE$(2)=CHR$(2)
  366. 4650 IF START.FLAG=1 THEN 1560 ELSE 1770
  367. 4660 '
  368. 4670 ' --------- TOGGLE LINE FEEDS ---------
  369. 4680 '
  370. 4690 IF LF.FLAG=1 THEN LF.FLAG=0 ELSE LF.FLAG=1
  371. 4700 GOTO 1770
  372. 4710 '
  373. 4720 ' --------- SUBROUTINE TO DISPLAY A TEXT FILE  ---------
  374. 4730 '
  375. 4740 ' --------- FILE NAME PASSED AS TEXT.FILE$ ---------
  376. 4750 '
  377. 4760 OPEN TEXT.FILE$ FOR INPUT AS #1
  378. 4770 LINES.DONE=0
  379. 4780 WHILE NOT EOF(1)
  380. 4790 LINE INPUT #1,MSG$
  381. 4800 GOSUB 5270
  382. 4810 LINES.DONE=LINES.DONE+1
  383. 4820 IF LINES.DONE < 24 THEN 4780
  384. 4830 MSG$="MORE (Y) OR N ?":GOSUB 5410
  385. 4840 TEMP$=RSP$:GOSUB 4240:RSP$=TEMP$
  386. 4850 IF RSP$<>"N" THEN LINES.DONE=0:GOTO 4780
  387. 4860 GOTO 4890
  388. 4870 WEND
  389. 4880 MSG$="MORE (Y) OR N ?":GOSUB 5410
  390. 4890 CLOSE #1
  391. 4900 RETURN
  392. 4910 '
  393. 4920 ' --------- PAUSE LOOP ----------------
  394. 4930 ' --------- LENGTH OF PAUSE IN SECONDS IS PASSSED AS PAUSE.TIME
  395. 4940 ' --------- USES TIME SINCE MIDNIGHT SO WILL GET SCREWED UP
  396. 4950 ' --------- IF RUNNING WHEN ROLLOVER OCCURS??????
  397. 4960 '
  398. 4970 TIME.PASSED=0:BEGIN.TIME$=TIME$
  399. 4980 BEGIN.SECONDS=VAL(MID$(BEGIN.TIME$,1,2))*3600+VAL(MID$(BEGIN.TIME$,4,2))*60+VAL(MID$(BEGIN.TIME$,7,2))
  400. 4990 WHILE TIME.PASSED<PAUSE.TIME
  401. 5000 NOW.TIME$=TIME$
  402. 5010 NOW.SECONDS=VAL(MID$(NOW.TIME$,1,2))*3600+VAL(MID$(NOW.TIME$,4,2))*60+VAL(MID$(NOW.TIME$,7,2))
  403. 5020 TIME.PASSED=NOW.SECONDS-BEGIN.SECONDS
  404. 5030 WEND
  405. 5040 RETURN
  406. 5050 '
  407. 5060 ' --------- SUBROUTINE TO GET USER'S PARAMETERS AND OPEN COMM PORT ---------
  408. 5070 ' --------- USES PATH AND FILE NAME FROM CONFIG FILE TO FIND
  409. 5080 ' --------- MESSAGE FILE AND USES HEADER TO GET PARAMETERS
  410. 5090 '
  411. 5100 LINE.FEED$=CHR$(10):CARRIAGE.RETURN$=CHR$(13)
  412. 5110 FOR TEMP=1 TO 25:CLEAR.SCR$=CLEAR.SCR$+LINE.FEED$:NEXT TEMP
  413. 5120 OPEN "R",1,MSG.PATH$+MSG.FILE$:FIELD 1,128 AS USER.RECORD$
  414. 5130 GET 1,NODE.NUMBER+1:BAUD=VAL(MID$(USER.RECORD$,44,2)):PARAM=VAL(MID$(USER.RECORD$,42,2))
  415. 5140 USER.NAME$=LEFT$(USER.RECORD$,30)
  416. 5150 FOR TEMP=LEN(USER.NAME$) TO 1 STEP -1   'TRIM SPACES FROM NAME
  417. 5160 IF MID$(USER.NAME$,TEMP,1)<>" " THEN 5180
  418. 5170 NEXT TEMP
  419. 5180 USER.NAME$=LEFT$(USER.NAME$,TEMP)
  420. 5190 ' --------- GET COMM PORT PARAMETERS ---------
  421. 5200 IF PARAM=-1 THEN PARAM$="N,8,1,CS,DS,CD" ELSE PARAM$="E,7,1,CS,DS,CD"
  422. 5210 IF BAUD=-4 THEN BAUD$="2400" ELSE IF BAUD=-3 THEN BAUD$="1200," ELSE BAUD$="300,"
  423. 5220 CLOSE #1           'DONE WITH MESSAGE FILE
  424. 5230 MCR=&H3FC:MSR=&H3FE
  425. 5240 OPEN COMM.PORTS$(NODE.NUMBER)+BAUD$+PARAM$ AS #3
  426. 5250 RETURN
  427. 5260 '
  428. 5270 ' --------- SEND STRING WITH CARRIAGE RETURN ---------
  429. 5280 ' --------- STRING PASSED AS MSG$ 
  430. 5290 ' --------- IF LF.FLAG SET TO 1, LINE FEED PASSED AS WELL
  431. 5300 '
  432. 5310 PRINT MSG$:PRINT #3,MSG$
  433. 5320 IF LF.FLAG=1 THEN PRINT #3,LINE.FEED$
  434. 5330 RETURN
  435. 5340 '
  436. 5350 ' --------- SEND STRING WITH NO CARRIAGE RETURN ---------
  437. 5360 ' --------- STRING PASSED AS MSG$
  438. 5370 '
  439. 5380 PRINT MSG$;:PRINT #3,MSG$;
  440. 5390 RETURN
  441. 5400 '
  442. 5410 ' --------- GET RESPONSE FROM REMOTE USER ---------
  443. 5420 ' --------- MSG$ SENT AS PROMPT
  444. 5430 ' --------- RESPONSE RETURNED AS RSP$
  445. 5440 ' --------- IF CR.SUPPRESS = 1, NO CR ECHOED AFTER INPUT
  446. 5450 ' --------- IF ECHO.SUPPRESS = 1, NO ECHO AT ALL
  447. 5460 '
  448. 5470 GOSUB 5350
  449. 5480 RSP$=""
  450. 5490 WHILE EOF(3):CHAR$=INKEY$
  451. 5500 IF CHAR$<>"" THEN 5520 ELSE WEND:CHAR$="":GOSUB 5680
  452. 5510 CHAR$="":CHAR$=INPUT$(1,3):IF CHAR$=CHR$(127) THEN 5620
  453. 5520 IF CHAR$=CHR$(8) OR CHAR$=CHR$(7) OR CHAR$=CHR$(26) OR CHAR$=CHR$(27) THEN 5620
  454. 5530 IF CHAR$<" " AND CHAR$<>CARRIAGE.RETURN$ THEN 5490
  455. 5540 IF CHAR$=CARRIAGE.RETURN$ AND CR.SUPPRESS = 1 THEN 5610  'NO CR ECHO
  456. 5550 IF ECHO.OFF=1 THEN 5570  'SUPPRESS ECHO
  457. 5560 PRINT CHAR$;:PRINT #3,CHAR$;   'OK CHARACTER. ECHO.
  458. 5570 IF CHAR$=CARRIAGE.RETURN$ THEN 5600  '<CR> ENDS INPUT
  459. 5580 IF LEN(RSP$)=>254 THEN MSG$="INPUT TOO LONG...TRY AGAIN":GOSUB 5270:GOTO 5410
  460. 5590 RSP$=RSP$+CHAR$:GOTO 5490 'ADD TO RESPONSE AND GET NEXT CHARACTER
  461. 5600 IF LF.FLAG=1 THEN PRINT #3,LINE.FEED$  'SEND <LF> IF NECESSARY
  462. 5610 RETURN
  463. 5620 ' --------- SUBROUTINE TO DEAL WITH <DEL> IN INPUT STRING ---------
  464. 5630 IF LEN(RSP$)=0 THEN 5490  'IF FIRST CHARACTER THEN DOESN'T MATTER
  465. 5640 RSP$=LEFT$(RSP$,LEN(RSP$)-1)
  466. 5650 PRINT CHR$(29)+CHR$(32)+CHR$(29);  'DELETE ON SYSOP'S SCREEN
  467. 5660 PRINT #3,CHR$(8)+CHR$(32)+CHR$(8);  'DELETE ON REMOTE SCREEN
  468. 5670 GOTO 5490  'ALL SET. GET NEXT CHARACTER
  469. 5680 ' --------- CHECK FOR CARRIER ---------
  470. 5690 IF INP(MSR)<128 THEN PRINT "USER DROPPED CARRIER!!!":GOTO 5720
  471. 5700 RETURN
  472. 5710 '
  473. 5720 ' --------- CLOSING SUBROUTINE ----------------
  474. 5730 ' --------- CLOSES PORT UPDATES SCORE AND EXITS
  475. 5740 '
  476. 5750 OPEN "FLIPS.PTS" FOR OUTPUT AS #4
  477. 5760 PRINT #4,GAMES.PLAYED,COMP.WINS,HUMAN.WINS,USER.NAME$
  478. 5770 CLOSE #4
  479. 5780 MSG$="STAND BY.  RETURNING TO "+BOARD.NAME$+". . .":GOSUB 5350
  480. 5790 CLOSE 3:OUT MCR,INP(MCR) OR 1:SYSTEM
  481. 5800 '
  482. 5810 ' --------- SUBROUTINE TO READ CONFIGURATION FILE
  483. 5820 '
  484. 5830 ' CONFIG FILE ASSUMED TO BE TEXT FILE WITH ONE ENTRY PER LINE
  485. 5840 ' VARIABLES ASSUMED LISTED IN THE FOLLOWING ORDER:
  486. 5850 '
  487. 5860 ' BOARD.NAME$           NAME OF BULLETIN BOARD TO BE LISTED
  488. 5870 ' WELCOME.SCR$          PATH AND FILE NAME FOR WELCOME SCREEN
  489. 5880 ' WEL.PATH$             PATH TO FIND WELCOME SCREEN FILE
  490. 5890 ' MSG.FILE$             FILENAME FOR MESSAGE FILE
  491. 5900 ' MSG.PATH$             PATH TO FIND MESSAGE FILE
  492. 5910 ' HELP.FILE$            FILE TO DISPLAY FOR INSTRUCTIONS
  493. 5920 ' HLP.PATH$             PATH TO FIND INSTRUCTION FILE
  494. 5930 ' LF.FLAG               DEFAULT LINE FEED SETTING: 1 IF YES, 0 IF NO
  495. 5940 ' GRAPHICS.FLAG         DEFAULT GRAPHICS SETTING: 1 IF ASCII, 0 IF NONE
  496. 5950 ' MAX.GAMES             MAXIMUM GAMES A PLAYER IS ALLOWED
  497. 5960 ' MAX.TIME              MAXIMUM TIME IN MINUTES A PLAYER MAY SPEND
  498. 5970 ' COMM.PORTS$(1)        \
  499. 5980 ' COMM.PORTS$(2)         \   
  500. 5990 ' COMM.PORTS$(3)          >  COMM PORTS FOR NODES
  501. 6000 ' COMM.PORTS$(4)         /   1 THROUGH 5
  502. 6010 ' COMM.PORTS$(5)        /    
  503. 6020 ' COMP.MOVE.PAUSE       PAUSE TIME AFTER COMPUTER'S MOVE
  504. 6025 ' ALLOW.REPEAT.USER$     FLAG TO LOCK OUT RETURN USERS
  505. 6030 '
  506. 6040 OPEN "FLIPS.CNF" FOR INPUT AS #2
  507. 6050 LINE INPUT #2, BOARD.NAME$
  508. 6060 LINE INPUT #2, WELCOME.SCR$
  509. 6070 LINE INPUT #2, WEL.PATH$
  510. 6080 LINE INPUT #2, MSG.FILE$
  511. 6090 LINE INPUT #2, MSG.PATH$
  512. 6100 LINE INPUT #2, HELP.FILE$
  513. 6110 LINE INPUT #2, HLP.PATH$
  514. 6120 INPUT #2, LF.FLAG
  515. 6130 INPUT #2, GRAPHICS.FLAG
  516. 6140 INPUT #2, MAX.GAMES
  517. 6150 INPUT #2, MAX.TIME
  518. 6160 LINE INPUT#2, COMM.PORTS$(1)
  519. 6170 LINE INPUT#2, COMM.PORTS$(2)
  520. 6180 LINE INPUT#2, COMM.PORTS$(3)
  521. 6190 LINE INPUT#2, COMM.PORTS$(4)
  522. 6200 LINE INPUT#2, COMM.PORTS$(5)
  523. 6210 INPUT #2, COMP.MOVE.PAUSE
  524. 6212 INPUT #2, ALLOW.REPEAT.USER$
  525. 6220 CLOSE #2
  526. 6230 ' ---------- CHECK THAT PATHS AND FILENAMES HAVE PROPER FORMAT -----------
  527. 6240 IF ((RIGHT$(WEL.PATH$,1)<>"\" AND RIGHT$(WEL.PATH$,1)<>":") AND LEFT$(WELCOME.SCR$,1)<>"\") THEN WEL.PATH$=WEL.PATH$+"\"
  528. 6250 IF ((RIGHT$(MSG.PATH$,1)<>"\" AND RIGHT$(MSG.PATH$,1)<>":") AND LEFT$(MSG.FILE$,1)<>"\") THEN MSG.PATH$=MSG.PATH$+"\"
  529. 6260 IF ((RIGHT$(HLP.PATH$,1)<>"\" AND RIGHT$(HLP.PATH$,1)<>":") AND LEFT$(HELP.FILE$,1)<>"\") THEN HLP.PATH$=HLP.PATH$+"\"
  530. 6270 RETURN
  531. 6280 '
  532. 6290 '
  533. 6300 ' ----------------  MAIN ERROR TRAP ---------
  534. 6310 ' ----------------  ALL ERRORS PASS THROUGH HERE
  535. 6320 '
  536. 6330 IF ERR=200 THEN 6880
  537. 6340 IF ERL=6040 AND (ERR=53 OR ERR=76) THEN 6540 'CFG FILE NOT FOUND
  538. 6350 IF ERL=6040 THEN 6560   'ERROR OPENING CFG FILE
  539. 6360 IF ERL>=6050 AND ERL<=6220 THEN 6580  'ERROR READING CFG FILE
  540. 6370 IF ERL=5120 AND (ERR=53 OR ERR=76) THEN 6600 ' MSG FILE NOT FOUND
  541. 6380 IF ERL=5120 THEN 6620 'ERROR OPENING MSG FILE
  542. 6390 IF ERL=5130 THEN 6640 'ERROR READING MSG FILE
  543. 6400 IF ERL=5240 THEN 6660 'ERROR ADRESSING COMM PORT
  544. 6410 IF ERL=4760 AND (ERR=53 OR ERR=76) AND (TEXT.FILE$=WEL.PATH$+WELCOME.SCR$) THEN 6680 'WELC FILE NOT FND
  545. 6420 IF ERL=4760 AND (TEXT.FILE$=WEL.PATH$+WELCOME.SCR$) THEN 6700 'ERROR OPNG WEL FILE
  546. 6430 IF ERL=4790 AND (TEXT.FILE$=WEL.PATH$+WELCOME.SCR$) THEN 6720 'ERROR RDG WEL FILE
  547. 6440 IF ERL=4760 AND (ERR=53 OR ERR=76) AND (TEXT.FILE$=HLP.PATH$+HELP.FILE$) THEN 6740 'HLP FILE NOT FND
  548. 6450 IF ERL=4760 AND (TEXT.FILE$=HLP.PATH$+HELP.FILE$) THEN 6760 'ERROR OPNG HLP FILE
  549. 6460 IF ERL=4790 AND (TEXT.FILE$=HLP.PATH$+HELP.FILE$) THEN 6780 'ERROR RDG HLP FILE
  550. 6470 IF ERL=1590 THEN 6800
  551. 6480 IF ERL=1600 THEN 6820
  552. 6490 IF ERL=5750 THEN 6840
  553. 6500 IF ERL=5760 THEN 6860
  554. 6510 ' --------- UNACOUNTED FOR ERROR ----------------
  555. 6520 MSG$="Error #"+STR$(ERR)+" at line "+STR$(ERL)+ "of FLIPS. Please tell Sysop."
  556. 6530 GOSUB 5270:RESUME 5720
  557. 6540 MSG$="FLIPS Configuration file missing. Please tell Sysop."
  558. 6550 PRINT MSG$:RESUME 5790
  559. 6560 MSG$="Error opening FLIPS configuration file. Please tell Sysop."
  560. 6570 PRINT MSG$:RESUME 5790
  561. 6580 MSG$="Error reading FLIPS configuration file. Please tell Sysop."
  562. 6590 PRINT MSG$:RESUME 5790
  563. 6600 MSG$="FLIPS couldn't find MESSAGE file.  Please tell Sysop."
  564. 6610 GOSUB 5270:RESUME 5720
  565. 6620 MSG$="Error opening MESSAGE file. Please tell Sysop."
  566. 6630 GOSUB 5270:RESUME 5720
  567. 6640 MSG$="Error reading MESSAGE file. Please tell Sysop."
  568. 6650 GOSUB 5270:RESUME 5720
  569. 6660 MSG$="FLIPS error addressing communications port: "+COMM.PORTS$(NODE.NUMBER)
  570. 6670 PRINT MSG$:RESUME 5790
  571. 6680 MSG$="FLIPS welcome screen missing. Please tell Sysop."
  572. 6690 GOSUB 5270:RESUME 4900
  573. 6700 MSG$="Error opening welcome screen. Please tell Sysop."
  574. 6710 GOSUB 5270:RESUME 4900
  575. 6720 MSG$="Error reading welcome screen. Please tell Sysop."
  576. 6730 GOSUB 5270:RESUME 4890
  577. 6740 MSG$="FLIPS help screen missing. Please tell Sysop."
  578. 6750 GOSUB 5270:RESUME 4900
  579. 6760 MSG$="Error opening help screen. Please tell Sysop."
  580. 6770 GOSUB 5270:RESUME 4900
  581. 6780 MSG$="Error reading help screen. Please tell Sysop."
  582. 6790 GOSUB 5270:RESUME 4890
  583. 6800 MSG$="Error opening score file. Please tell Sysop."
  584. 6810 GOSUB 5270:RESUME 1770
  585. 6820 MSG$="Error reading score file. Please tell Sysop."
  586. 6830 GOSUB 5270:RESUME 1610
  587. 6840 MSG$="Error opening score file. Please tell Sysop."
  588. 6850 GOSUB 5270:RESUME 5780
  589. 6860 MSG$="Error writing to score file. Please tell Sysop."
  590. 6870 GOSUB 5270:RESUME 5770
  591. 6880 MSG$="Flips is not configured for this node.  Aborting."
  592. 6890 PRINT MSG$:RESUME 5790
  593. 6900 END
  594.